home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / TPRCDR10 / ZAPDIR.PAS < prev   
Pascal/Delphi Source File  |  1993-12-26  |  3KB  |  98 lines
  1. { ╔═══════════╤════════════════════════════════════════════════╗
  2.   ║ Programmer│ Tony Papadimitriou                             ║
  3.   ║ Program   │ ZapDir                                         ║
  4.   ║ Uses      │ Dos, TPUtils, TPRecDir                         ║
  5.   ║ Includes  │ Nothing                                        ║
  6.   ║ Links     │ Nothing                                        ║
  7.   ║ Created   │ Sunday, December 19, 1993  2:08 am             ║
  8.   ║ Updated   │ Saturday, December 25, 1993  3:50 pm           ║
  9.   ║ Language  │ (MSDOS) Turbo Pascal 6.0                       ║
  10.   ║ Purpose   │ Show off TPRecDir unit.  Use with CAUTION.     ║
  11.   ╟───────────┴┬──────── Version History ──────────────────────╢
  12.   ║ 1.00       │Original                                       ║
  13.   ╚════════════╧═══════════════════════════════════════════════╝ }
  14. uses
  15.   Dos,
  16.   TPUtils,
  17.   TPRecDir;
  18.  
  19. const
  20.   progName = 'ZAPDIR';
  21.   version  = '1.00';
  22.  
  23. procedure Copyright;
  24. begin
  25.   Writeln(stderr);
  26.   Writeln(stderr,progName+' ver. ' + version + ' ■ Copyright (c) 1993-94 by Tony G. Papadimitriou *FREEWARE*');
  27.   Writeln(stderr);
  28. end; { Copyright }
  29.  
  30. var
  31.   dirs,
  32.   files: Longint;
  33.  
  34. { --- this is the user routine whose address you must supply to ForEachFileIn }
  35. { --- it must be True on success }
  36. function List(rec: SearchRec): Boolean; far;
  37. var
  38.   f     : file;
  39.   code  : Word;
  40.   errors: Boolean;
  41. begin
  42.   if AttributeMatches(rec.attr,Directory) then
  43.   begin
  44.     {$I-} RmDir(rec.name); {$I+}
  45.     code   := IOResult;
  46.     errors := code <> 0;
  47.     if not errors then
  48.     begin
  49.       Writeln('Removed dir ',FExpand(rec.name));
  50.       Inc(dirs);
  51.     end
  52.     else
  53.       Writeln('Could not remove directory ',FExpand(rec.name),' due to error code ',code);
  54.   end
  55.   else
  56.   begin
  57.     Assign(f,rec.name);
  58.     SetFAttr(f,Archive);
  59.     {$I-} Erase(f); {$I+}
  60.     code   := IOResult;
  61.     errors := code <> 0;
  62.     if not errors then
  63.     begin
  64.       Writeln('Erased file ',FExpand(rec.name));
  65.       Inc(files);
  66.     end
  67.     else
  68.       Writeln('Could not erase file ',FExpand(rec.name),' due to error code ',code);
  69.   end;
  70.   List := not errors;
  71. end; { List }
  72.  
  73. var
  74.   counter: Longint;
  75.   path   : String;
  76.   mask   : String;
  77. begin
  78.   Copyright;
  79.   if ParamCount = 0 then
  80.   begin
  81.     Writeln(stderr,'Usage: ZapDir [<path>\]<mask>[;<mask>]');
  82.     Writeln(stderr);
  83.     Writeln(stderr,'       Press ESC during search to interrupt prematurely.');
  84.     Halt;
  85.   end; { if }
  86.   dirs  := 0;
  87.   files := 0;
  88.   path := ParamStr(1);
  89.   mask := GetMask(path);
  90.   path := GetPath(path);
  91.   counter := ForEachFileIn(path,mask,AnyFile,True,True,@List);
  92.   if errorsFound then Writeln(stderr,'Errors during processing!');
  93.   Writeln(stderr,'Deleted ',dirs,' dir'+OneManyStr(dirs,'','s')+
  94.                  ' and ',files,' file'+OneManyStr(files,'','s')+
  95.                  ' for a total of ',counter,
  96.                  ' match'+OneManyStr(counter,'','es'));
  97. end.
  98.